home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / amiga / amigaker.arc / 06.console < prev    next >
Text File  |  1987-12-30  |  15KB  |  368 lines
  1. ;
  2. ;  06.console
  3. ;
  4. ;  Exec IO support routines, not included in the roms, but supplied
  5. ;  with C. The routines below are the same
  6. ;
  7. ;  Console support routines through which forth communicates
  8. ;
  9.  
  10. * setport         (s pri name signal port task -- port )
  11.                   ; small word to set fields in a port struc.
  12.                   dc.w     -1
  13.                   dc.l     execlink3
  14. execlink3         set      *-4
  15.                   dc.b     $87,'setpor',$80!'t'
  16.                   cnop     0,2
  17. _setport          dc.l     *+4
  18.                   move.l   (sp)+,d0
  19.                   move.l   (sp)+,a0
  20.                   move.l   d0,16(a0)         ;set task pointer
  21.                   movem.l  (sp)+,d0-d2
  22.                   move.b   d0,15(a0)         ;signal bit
  23.                   move.l   d1,10(a0)         ;name
  24.                   move.b   d2,9(a0)          ;priority
  25.                   move.b   #4,8(a0)          ;type to NT_MSGPORT
  26.                   move.b   #0,14(a0)         ;flags to PA_SIGNAL
  27.                   move.l   a0,-(sp)
  28.                   jmp      (a3)
  29.  
  30. * CreatePort      (s name pri -- port | 0 )
  31.                   ; creates a port structure for current task with a signal
  32.                   ; and a signal action, if a name is given the port is
  33.                   ; made public.
  34.                   dc.w     -1
  35.                   dc.l     execlink3
  36. execlink3         set      *-4
  37.                   dc.b     $8a,'CreatePor',$80!'t'
  38.                   cnop     0,2
  39. _CreatePort       dc.l     nest
  40.                   dc.l     _minus_1,_AllocSignal,_minus_1,_over,_equals
  41.                   dc.l     _question_branch,1$
  42.                   dc.l       _drop,_2drop,_0,_exit
  43. 1$                dc.l     _nest_lit,$10001,_nest_lit,$22,_AllocMem
  44.                   dc.l     _question_dup,_0_equal,_question_branch,2$
  45.                   dc.l       _FreeSignal,_2drop,_0,_exit
  46. 2$                dc.l     _to_r,_to_r,_over,_r_from,_r_from
  47.                   dc.l     _0,_FindTask,_setport,_tuck
  48.                   dc.l     _swap,_0_equal,_question_branch,3$
  49.                   dc.l       _nest_lit,20,_plus,_NewList,_branch,4$
  50. 3$                dc.l       _AddPort
  51. 4$                dc.l     _exit
  52.  
  53. * DeletePort      (s port -- )
  54.                   ; deletes port structure created by the above routine.
  55.                   dc.w     -1
  56.                   dc.l     execlink0
  57. execlink0         set      *-4
  58.                   dc.b     $8a,'DeletePor',$80!'t'
  59.                   cnop     0,2
  60. _DeletePort       dc.l     *+4
  61.                   move.l   a3,-(rp)          ;save @next restore at end
  62.                   move.l   (sp),a0           ;get port pointer
  63.                   tst.l    10(a0)            ;if named must remove port
  64.                   beq.s    1$
  65.                   move.l   a0,-(sp)          ;'like dup'
  66.                   lea      _RemPort,w
  67.                   jsr      docallrom
  68.                   move.l   (sp),a0           ;restore pointer
  69. 1$                moveq    #-1,d0
  70.                   move.b   d0,8(a0)          ;set node.type to xff
  71.                   move.l   d0,20(a0)         ; and lh_head to -1
  72.                   moveq    #0,d0
  73.                   move.b   15(a0),d0         ;get signal number.
  74.                   move.l   d0,-(sp)
  75.                   lea      _FreeSignal,w
  76.                   jsr      docallrom
  77.                   pea      34                ;(s port size --
  78.                   lea      _FreeMem,w
  79.                   jsr      docallrom
  80.                   move.l   (rp)+,a3          ;restore @next
  81.                   jmp      (a3)
  82.  
  83. * CreateExtIO     (s port size -- 'IOrequest )
  84.                   ; Allocates memory and initializes the IOrequest
  85.                   ; structure.
  86.                   dc.w     -1
  87.                   dc.l     execlink3
  88. execlink3         set      *-4
  89.                   dc.b     $8b,'CreateExtI',$80!'O'
  90.                   cnop     0,2
  91. _CreateExtIO      dc.l     nest
  92.                   dc.l     _over,_0_equal,_question_branch,1$
  93.                   dc.l       _2drop,_0,_exit
  94. 1$                dc.l     _nest_lit,$10001,_over,_AllocMem
  95.                   dc.l     _question_dup,_0_equal,_question_branch,2$
  96.                   dc.l       _2drop,_0,_exit
  97. 2$                dc.l     _dup,_to_r
  98.                   dc.l     _nest_lit,5,_over,_8_plus,_c_store  ; type
  99.                   dc.l     _nest_lit,18,_plus,_w_store         ; length
  100.                   dc.l     _r_fetch,_nest_lit,14,_plus,_store  ; port
  101.                   dc.l     _r_from,_exit
  102.  
  103. * DeleteExtIO     (s IOrequest -- )
  104.                   ; deletes user sized iorequest structure.
  105.                   dc.w     -1
  106.                   dc.l     execlink0
  107. execlink0         set      *-4
  108.                   dc.b     $8b,'DeleteExtI',$80!'O'
  109.                   cnop     0,2
  110. _DeleteExtIO      dc.l     *+4
  111.                   move.l   a3,-(rp)          ;save @next
  112.                   move.l   (sp),a0           ;get request pointer
  113.                   beq.s    1$                ; if zero do nothing
  114.                   moveq    #-1,d0
  115.                   move.b   d0,8(a0)          ;set type to xff
  116.                   move.l   d0,20(a0)         ; device to -1
  117.                   move.l   d0,24(a0)         ; unit to -1
  118.                   moveq    #0,d0
  119.                   move.w   18(a0),d0         ;get messagenode.length
  120.                   move.l   d0,-(sp)          ;(s request length --
  121.                   lea      _FreeMem,w
  122.                   jsr      docallrom
  123. 1$                move.l   (rp)+,a3          ;restore @next
  124.                   jmp      (a3)
  125.  
  126. * DeleteStdIO     (s IOrequest -- ) frees up the memory for
  127.                   ; a standard IOrequest.
  128.                   dc.w     -1
  129.                   dc.l     execlink0
  130. execlink0         set      *-4
  131.                   dc.b     $8b,'DeleteExtI',$80!'O'
  132.                   cnop     0,2
  133. _DeleteStdIO      dc.l     nest
  134.                   dc.l     _DeleteExtIO,_exit
  135.  
  136. * CreateStdIO     (s port -- 'IOStdrequest | 0 )
  137.                   ; Creates a StdIOrequest and sets port pointer to port.
  138.                   dc.w     -1
  139.                   dc.l     execlink3
  140. execlink3         set      *-4
  141.                   dc.b     $8b,'CreateStdI',$80!'O'
  142.                   cnop     0,2
  143. _CreateStdIO      dc.l     nest
  144.                   dc.l     _nest_lit,48,_CreateExtIO
  145.                   dc.l     _exit
  146.  
  147. ; that's the end of the Exec support routines.
  148.  
  149.  
  150.  
  151. * ConWritePort    (s -- addr )  A variable holding the address of
  152.                   ; console write port.
  153.                   dc.w     -1
  154.                   dc.l     link3
  155. link3             set      *-4
  156.                   dc.b     $8c,'ConWritePor',$80!'t'
  157.                   cnop     0,2
  158. _ConWritePort     dc.l     docreate
  159.                   dc.l     0
  160.  
  161. * ConReadPort     (s -- addr )  A variable holding the address of
  162.                   ; console read port.
  163.                   dc.w     -1
  164.                   dc.l     link3
  165. link3             set      *-4
  166.                   dc.b     $8b,'ConReadPor',$80!'t'
  167.                   cnop     0,2
  168. _ConReadPort      dc.l     docreate
  169.                   dc.l     0
  170.  
  171. * ConWriteMsg     (s -- addr )  Variable to hold the write message struct.
  172.                   dc.w     -1
  173.                   dc.l     link3
  174. link3             set      *-4
  175.                   dc.b     $8b,'ConWriteMs',$80!'g'
  176.                   cnop     0,2
  177. _ConWriteMsg      dc.l     docreate
  178.                   dc.l     0
  179.  
  180. * ConReadMsg      (s -- addr )  Variable holding the read message struct.
  181.                   dc.w     -1
  182.                   dc.l     link3
  183. link3             set      *-4
  184.                   dc.b     $8a,'ConReadMs',$80!'g'
  185.                   cnop     0,2
  186. _ConReadMsg       dc.l     docreate
  187.                   dc.l     0
  188.  
  189. * MakeConStuff    (s -- fl | t=ok. ) Sets up the ports and messages
  190.                   ; to read and write to a console.
  191.                   dc.w     -1
  192.                   dc.l     link1
  193. link1             set      *-4
  194.                   dc.b     $8c,'MakeConstuf',$80!'f'
  195.                   cnop     0,2
  196. _MakeConStuff     dc.l     nest
  197.                   dc.l     _nest_quote
  198.                   dc.b     13,'4thcon.write',0
  199.                   cnop     0,2
  200.                   dc.l     _drop,_0,_CreatePort
  201.                   dc.l     _dup,_0_notequal,_question_branch,1$
  202.                   dc.l     _dup,_ConWritePort,_store,_CreateStdIO
  203.                   dc.l     _dup,_0_notequal,_question_branch,1$
  204.                   dc.l     _ConWriteMsg,_store
  205.                   dc.l     _nest_quote
  206.                   dc.b     12,'4thcon.read',0
  207.                   cnop     0,2
  208.                   dc.l     _drop,_0,_CreatePort
  209.                   dc.l     _dup,_0_notequal,_question_branch,1$
  210.                   dc.l     _dup,_ConReadPort,_store,_CreateStdIO
  211.                   dc.l     _dup,_0_notequal,_question_branch,1$
  212.                   dc.l     _ConReadMsg,_store
  213.                   dc.l     _true
  214. 1$                dc.l     _exit
  215.  
  216. * OpenConsole     (s window -- fl  )  Opens a console.device in the window.
  217.                   ; Sets the write message and clones the device in the
  218.                   ; read message.
  219.                   ; AND! -- Immediately queues up a read request using the
  220.                   ; external buffer  * keybuffer * .
  221.                   dc.w     -1
  222.                   dc.l     link3
  223. link3             set      *-4
  224.                   dc.b     $8b,'OpenConsol',$80!'e'
  225.                   cnop     0,2
  226. _OpenConsole      dc.l     nest
  227.                   dc.l     _MakeConStuff,_0_equal,_question_branch,1$
  228.                   dc.l        _0,_exit
  229. 1$                dc.l     _ConWriteMsg,_fetch,_tuck
  230.                   dc.l     _nest_lit,40,_plus,_store
  231.                   dc.l     _dup,_nest_quote
  232.                   dc.b     15,'console.device',0
  233.                   cnop     0,2
  234.                   dc.l     _drop,_0,_0,_OpenDevice,_0_notequal
  235.                   dc.l     _question_branch,2$,_drop,_0,_exit
  236. 2$                dc.l     _nest_lit,20,_plus,_dup,_fetch,_swap
  237.                   dc.l     _4_plus,_fetch
  238.                   dc.l     _ConReadMsg,_fetch,_nest_lit,24,_plus,_tuck
  239.                   dc.l     _store,_4_minus,_store
  240.                   dc.l     _ConReadMsg,_fetch,_nest_lit,keybuffer,_QueRead
  241.                   dc.l     _true,_exit
  242.  
  243. * CloseConsole    (s -- )   Closes the console device. Deletes the
  244.                   ; messages and ports.
  245.                   dc.w     -1
  246.                   dc.l     link3
  247. link3             set      *-4
  248.                   dc.b     $8c,'CloseConsol',$80!'e'
  249.                   cnop     0,2
  250. _CloseConsole     dc.l     nest
  251.                   dc.l     _ConWriteMsg,_fetch,_CloseDevice
  252.                   dc.l     _ConWriteMsg,_fetch,_DeleteStdIO
  253.                   dc.l     _ConReadMsg,_fetch,_DeleteStdIO
  254.                   dc.l     _ConWritePort,_fetch,_DeletePort
  255.                   dc.l     _ConReadPort,_fetch,_DeletePort
  256.                   dc.l     _exit
  257.  
  258.  
  259. * QueRead         (s 'request 'buffer -- ) Starts an asynchronous read
  260.                   ; request
  261.                   dc.w     -1
  262.                   dc.l     link1
  263. link1             set      *-4
  264.                   dc.b     $87,'QueRea',$80!'d'
  265.                   cnop     0,2
  266. _QueRead          dc.l     *+4
  267.                   move.l   (sp)+,d0
  268.                   move.l   (sp),a0
  269.                   move.l   d0,40(a0)         ;set io_Data
  270.                   moveq    #1,d0
  271.                   move.l   d0,36(a0)         ;set io_Length to 1
  272.                   moveq    #2,d0
  273.                   move.w   d0,28(a0)         ;set io_Command to CMD_READ
  274.                   move.l   #_SendIO,w
  275.                   move.l   a3,-(rp)
  276.                   jsr      docallrom
  277.                   move.l   (rp)+,a3
  278.                   jmp      (a3)
  279.  
  280. * (key?)          (s -- fl ) Word returns true if a key is available.
  281.                   dc.w     -1
  282.                   dc.l     link3
  283. link3             set      *-4
  284.                   dc.b     $86,'(key?',$80!')'
  285.                   cnop     0,2
  286. _nest_key_question
  287.                   dc.l     *+4
  288.                   move.l   d0,-(sp)          ;prepare tos for flag
  289.                   move.l   _ConReadPort+4,a0 ;get port address
  290.                   move.l   20(a0),a0         ;get msg_list pointer
  291.                   tst.l    (a0)              ;if it points to 0 -> no messg.
  292.                   beq      no
  293.                   bra      yes
  294.  
  295. * (key)           (s -- char ) Returns next keypress. Waits for it.
  296.                   ; This routine functions the same as page 287 RKM.
  297.                   dc.w     -1
  298.                   dc.l     link3
  299. link3             set      *-4
  300.                   dc.b     $85,'(key',$80!')'
  301.                   cnop     0,2
  302. _nest_key         dc.l     *+4
  303. 1$                move.l   _ConReadPort+4,-(sp)
  304.                   move.l   a3,-(rp)
  305.                   lea      _GetMsg,w         ;test for waiting messg
  306.                   jsr      docallrom
  307.                   move.l   (rp)+,a3
  308.                   tst.l    (sp)+
  309.                   bne.s    2$
  310.                   move.l   _ConReadPort+4,-(sp)
  311.                   move.l   a3,-(rp)          ;if no messg sleep until one
  312.                   lea      _WaitPort,w
  313.                   jsr      docallrom
  314.                   move.l   (rp)+,a3
  315.                   addq.l   #4,sp
  316.                   bra.s    1$
  317. 2$                move.l   _ConReadMsg+4,a0
  318.                   lea      keybuffer,a1
  319.                   moveq    #0,d0
  320.                   move.b   (a1),d0           ;get key from buffer
  321.                   move.l   d0,-(sp)
  322.                   move.l   a0,-(sp)          ;and queue up the next read
  323.                   move.l   a1,-(sp)          ;request
  324.                   jmp      _QueRead+4
  325.  
  326. * (type)          (s addr len -- ) Type the string at the console.
  327.                   ; NOTE it also adds the length to #out.
  328.                   dc.w     -1
  329.                   dc.l     link0
  330. link0             set      *-4
  331.                   dc.b     $86,'(type',$80!')'
  332.                   cnop     0,2
  333. _nest_type        dc.l     *+4
  334.                   move.l   (sp)+,d0
  335.                   move.l   (sp)+,a0
  336.                   move.l   d0,-(rp)
  337.                   move.l   _ConWriteMsg+4,a1
  338.                   move.l   d0,36(a1)
  339.                   move.l   a0,40(a1)
  340.                   moveq    #3,d0
  341.                   move.w   d0,28(a1)
  342.                   move.l   a1,-(sp)
  343.                   move.l   a3,-(rp)
  344.                   lea      _DoIO,w
  345.                   jsr      docallrom
  346.                   move.l   (rp)+,a3
  347.                   move.l   (rp)+,d0
  348.                   addq.l   #4,sp
  349.                   lea      _number_out+4,a0
  350.                   add.l    d0,(a0)
  351.                   jmp      (a3)
  352.  
  353. * emit            (s c -- )  Print character on the screen. This routine
  354. ; calls type to print the character, it uses * stdbuffer * to
  355. ; store the character, in order to call type.
  356. ; Type is deferred, so emit is also redirected if type is.
  357. ; Stdbuffer is also used by 'm-emits'(multiple emits) for temporary storage.
  358.                   dc.w     -1
  359.                   dc.l     link1
  360. link1             set      *-4
  361.                   dc.b     $84,'emi',$80!'t'
  362.                   cnop     0,2
  363. _emit             dc.l     nest
  364.                   dc.l     _stdbuffer,_c_store,_stdbuffer,_1
  365.                   dc.l     _type,_exit
  366.  
  367.  
  368.